with GNAT.Byte_Swapping;
with Ada.Unchecked_Conversion;
package body MIDI is

   function To_Uint32 (V : Var_Length_Type) return Uint32_be
   is
      Result : Uint32_be := 0;
   begin
      for b of V loop
         Result := (Result * 128) or Uint32_be(b and 2#0111_1111#);
      end loop;
      return Result;
   end To_Uint32;

   function To_Var_Length (X : Uint32_be) return Var_Length_Type
   is
      r   : Uint32_be := X;
      buf : Var_Length_Type(1..4);
      n   : Natural := buf'Last;
   begin
      GNAT.Byte_Swapping.Swap4(buf(1)'Address);
      loop
         buf(n) := Uint8_t(r mod 128);
         r := r / 128;
         exit when r = 0;
         n := n - 1;
      end loop;
      for i in n .. buf'Last - 1 loop
         buf(i) := buf(i) or 128;
      end loop;
      return buf(n .. buf'Last);
   end To_Var_Length;

   function Input (
      From : not null access Root_Stream_Type'Class
      ) return Var_Length_Type
   is
      buf : Var_Length_Type(1 .. 4);
      n   : Natural := 1;
   begin
      loop
         declare
            b : Uint8_t := Uint8_t'Input(From);
         begin
            buf(n) := b;
            exit when b < 128;
            n := n + 1;
         end;
      end loop;
      return buf(1..n);
   end Input;

   procedure Output (
      To   : not null access Root_Stream_Type'Class;
      From : Var_Length_Type 
      )
   is
   begin
      Var_Length_Type'Write(To, From);
   end Output;

   function Input (
      From : not null access Root_Stream_Type'Class
      ) return Uint32_vl
   is
   begin
      return Uint32_vl(To_Uint32(Var_Length_Type'Input(From)));
   end Input;

   procedure Read (
      From : not null access Root_Stream_Type'Class;
      To   : out Uint32_vl
      )
   is
   begin
      To := Uint32_vl'Input(From);
   end Read;

   procedure Output (
      To   : not null access Root_Stream_Type'Class;
      From : Uint32_vl 
      )
   is
   begin
      Var_Length_Type'Output(To, To_Var_Length(Uint32_be(From)));
   end Output;

   function To_Uint32 (X : Uint24_t) return Uint32_be
   is
      Result : Uint32_be := 0;
   begin
      for b of X loop
         Result := Result * 256 + Uint32_be(b);
      end loop;
      return Result;
   end To_Uint32;

   function To_Uint24 (X : Uint32_be) return Uint24_t
   is
      r   : Uint32_be := X;
      buf : Uint24_t;
   begin
      for b of reverse buf loop
         b := Uint8_t(r mod 256);
         r := r / 256;
      end loop;
      return buf;
   end To_Uint24;

   function To_Tick_Div (T : Timing_Type) return Uint16_be
   is
   begin
      case T.Metrical is
         when True  => 
            return T.Beats_Per_Minute and Timing_Mask;
         when False => 
            return (T.Frames_Per_Second * 256 + T.Sub_Frames_Per_Frame) or Timing_Flag;
      end case;
   end To_Tick_Div;

   function To_Timing (T : Uint16_be) return Timing_Type
   is
      S : Uint16_be := T and Timing_Mask;
   begin
      if (T and Timing_Flag) = 0 then
         return (True, Beats_Per_Minute => S);
      else
         return (False, S / 256, S mod 256);
      end if;
   end To_Timing;

   function To_Microseconds (
      Delta_Time        : Uint32_be;
      Beats_Per_Minutes : Uint16_be;
      Clocks_Per_Beat   : Uint8_t
      ) return Uint32_be
   is
      ms_per_minute : constant := 60 * 1000 * 1000;
      ms_per_beat : Uint32_be := ms_per_minute / Uint32_be(Beats_Per_Minutes);
   begin
      return Delta_Time * ms_per_beat / Uint32_be(Clocks_Per_Beat); 
   end To_Microseconds;

   function To_Microseconds (
      Delta_Time            : Uint32_be;
      Microseconds_Per_Beat : Uint32_be;
      Clocks_Per_Beat       : Uint8_t
      ) return Uint32_be
   is
   begin
      return Delta_Time * Microseconds_Per_Beat / Uint32_be(Clocks_Per_Beat); 
   end To_Microseconds;

   function To_Uint16 (Bank : Bank_Type) return Uint16_be
   is
   begin
      return Uint16_be(Bank.MSB) * 256 + Uint16_be(Bank.LSB);
   end To_Uint16;

end MIDI;
